﻿module Layout

open System

open System.Windows
open Dom
open StyledElements
open HtmlDom
open HtmlParser
open Utils
open TextRendering
open ComputedStyle
open Lines
open Boxes
open Floats
open TextSplitter

(*
    Layout is the process of converting a DOM-tree into a tree of boxes,
    each box have a size and a position relative to its parent
*)


type RelPos = RelPos of int*int with
    member this.addX dx = this.add dx 0
    member this.addY dy = this.add 0 dy
    member this.add (dx:int) dy =
        let (RelPos(x,y))=this
        RelPos(x+dx,y+dy)
    



(*
    Breaking nodes into blocks and inline flows
*)
type Box = 
    | Block of IStyledElement 
    | InlineFlow of InlineUnit list

type Buffer = Buffer of InlineUnit list * Box list with
    member this.addInlineUnits units1 =
        let (Buffer(units, boxes)) = this
        Buffer(units @ units1, boxes)
    member this.addBlock block =        
        let (Buffer(units, boxes)) = this
        match units with
        | [] -> Buffer(units, boxes@[Block(block)])
        | lst -> Buffer([], boxes@[InlineFlow(lst);Block(block)])
    member this.close () =        
        let (Buffer(units, boxes)) = this
        match units with
        | [] -> boxes
        | lst -> boxes@[InlineFlow(lst)]

let blockList (nodes:IStyledNode list) =        
    (* Take the immediate children of a block-level element 
        turn into sequence of blocks / inline-flows
    *)
    let rec visit (buffer:Buffer) (node:IStyledNode)  =
        match node with
        | :? IStyledText as text ->
            let units = splitTextIntoWordUnits text
            buffer.addInlineUnits units
        | :? IStyledElement as elem ->            
            match elem.computedStyle().float with
            | Float.Left -> buffer.addInlineUnits [(Float(elem,true))]
            | Float.Right -> buffer.addInlineUnits [(Float(elem,false))]
            | _ ->
                match elem.computedStyle().display with
                | Display.Inline -> visitNodes (elem.childNodes) buffer
                | Display.Block | Display.Table | Display.ListItem
                | Display.TableRow | Display.TableCell
                    -> buffer.addBlock elem
                | Display.InlineBlock | Display.InlineTable 
                    -> buffer.addInlineUnits [(InlineBlockUnit(elem))]
                | Display.None -> buffer
        | _ -> buffer

    and visitNodes (nodes:IStyledNode list) (buffer:Buffer) =
        nodes |> List.fold visit buffer

    let buf = visitNodes nodes (Buffer([],[]))
    buf.close()


let unitHeight (unit:LayoutedInlineUnit) = unit.height
let unitWidth (unit:LayoutedInlineUnit) = unit.widthIncludingTrailingWhitespace

(* layout mode: Auto: boxes grow horizontally to fill available width. Fit: Boxes become a small as possible to contain content *)
type Mode = Auto | Fit


let rec layoutLineBox units (availableWidth:int,parentHeight:int option) (mode:Mode) (flow:Flow) (flowRel:FloatOffset) =
    (* layouts the formatted units of a line box *)
    let lineBoxHeight = units |> List.map unitHeight |> List.max
    let lineBoxWidth = units |> List.map unitWidth |> List.sum

    let processUnit (relativeX, layouts) unit  =
        let width, layout =
            match unit with        
            | LayoutedWordUnit(textBox) as word ->            
                    let width = unit.widthIncludingTrailingWhitespace
                    let layout = TextBoxLayout(textBox) 
                    width, layout
            | LayoutedInlineBlock(layout) as block ->
                    let width = block.width
                    width, layout
        let pos = (relativeX, 0)
        (relativeX + width), (layouts @ [(pos,layout)])

    let x, items = units |> List.fold processUnit (0, [])
    BoxLayout(BoxSize(lineBoxWidth, lineBoxHeight), items)

(*
    Transforms a sequence of inline nodes into one or more line boxes
*)
and layoutInlineSequence (units:InlineUnit list) (availableWidth:int,parentHeight:int option) (mode:Mode) (flow:Flow) (flowRel:FloatOffset) (layers:Layers) =

    let lines, flow, layers = toLines layoutInlineBlock units (availableWidth,parentHeight) flow flowRel layers
    if lines.Length=0 then
        // may happen if we have only empty inline nodes
        NoLayout, flow, layers
    else
        let mutable bottomEdgeY = 0
        let mutable lineLayouts = []
        let mutable mflow = flow
        let mutable mlayers = layers
        for (Line(units,l,r,y)) in lines do
            let box = layoutLineBox units (availableWidth,parentHeight) mode mflow (flowRel.addTop y)
            (* TODO: we always align left here - should flow left of right or justify *)
            do lineLayouts <- List.append lineLayouts [((l, y), box)]
            do bottomEdgeY <- y + box.size.height
        let lineLayouts = lineLayouts
        let width = List.max [for (_,layout) in lineLayouts -> layout.size.width]
        // not sure if this box is necessary, or we just should concat
        BoxLayout(BoxSize(width, bottomEdgeY), lineLayouts), flow, layers

and layoutBlockContent (elem:IStyledElement) (availableWidth:int) (mode:Mode) (flow:Flow) flowRel (layers:Layers) : Layout*Flow*Layers =
    match (box elem) with
    | :? IReplacedElement as replaced ->
        let width, height = replaced.intrinsicSize()
        ReplacedContentLayout(BoxSize(width, height), replaced) , flow, layers
    | _ -> 
        match elem.computedStyle().display with
        | Display.Table -> layoutTableContent elem availableWidth mode flow flowRel layers
        | _ -> layoutBlockChildren elem availableWidth mode flow flowRel layers

and layoutTableContent (elem:IStyledElement) (availableWidth:int) (mode:Mode) (flow:Flow) (flowRel:FloatOffset) (layers:Layers) : Layout*Flow*Layers =
    let table = elem
    let rows = elem.childNodes |> Seq.cast<IStyledElement> |> Seq.toList
    let colCount = List.max [for row in rows -> row.childNodes.Length]
    (* very simple table implementation - just distributre column widths evenly *)
    let cellSpacing = 10
    let rowWidth = (availableWidth - (colCount-1)*cellSpacing) / colCount
    
    let layoutCellContent cellElem = 
        let layout,_,_ = layoutBlockElem1 cellElem (rowWidth,None) mode flow flowRel layers
        layout
    
    let layoutRowContent (rowElem:IStyledElement) = 
        let cellsElems = rowElem.childNodes |> Seq.cast<IStyledElement> |> Seq.toList
        cellsElems |> List.map layoutCellContent

    let layoutedRowsPass1 = rows |> List.map layoutRowContent

    let rec transpose = function
        | (_::_)::_ as M -> List.map List.head M :: transpose (List.map List.tail M)
        | _ -> []

    let cols = transpose layoutedRowsPass1
    let colWidths = [for col in cols -> List.max [for cell in col -> cell.size.width]]

    let sizedRowCells (cells:Layout list) = 
        let height = List.max [for layout in cells -> layout.size.height]
        let sizedCells = [for (cell,width) in (Seq.zip cells colWidths) -> (width,height,cell)]
        (height, sizedCells)

    let sizedTable = layoutedRowsPass1 |> List.map sizedRowCells

    let adjustLayout ((cellWidth,cellHeight,layout):int*int*Layout) =
        (* When width an height is known for cells, we adjust the cell size *)
        let (ElementBoxLayout(_, elem, children)) = layout
        ElementBoxLayout(BoxSize(cellWidth, cellHeight), elem, children)

    let layoutCell ((x,children):(int * PlacedLayout list)) (width,height,cellLayout) =
        let placedLayout = (x, 0), (adjustLayout (width,height,cellLayout))
        (x + width + cellSpacing, children @[ placedLayout ])

    let layoutRow ((y,children):(int * PlacedLayout list)) ((rowHeight, cells):int* (int*int*Layout) list) =
        let x, placedCells = cells |> List.fold layoutCell (0,[])
        let layout = BoxLayout(BoxSize(availableWidth, rowHeight), placedCells) 
        let placedLayout = (0,y), layout
        (y + rowHeight + cellSpacing, children @[ placedLayout ])

    let (y, children) = sizedTable |> List.fold layoutRow (0,[])
    BoxLayout(BoxSize(availableWidth, y - cellSpacing), children), flow, layers


(* Lays out child-boxes vertically *)
and layoutBlockChildren (elem:IStyledElement) (availableWidth:int) (mode:Mode) (flow:Flow) (flowRel:FloatOffset) (layers:Layers) : Layout*Flow*Layers =
    let mutable relativeY = 0
    let mutable marginAfter = 0
    let mutable children = []
    let blocks = blockList elem.childNodes
    if blocks.Length=0 
    then NoLayout, flow, layers // if no visible children
    else
        let mutable mflow = flow
        let mutable mlayers = layers
        for block in blocks do
            let pos, layout =
                match block with
                    | Block elem -> 
                        let style = elem.computedStyle()
                        let marginBefore = max 0  (style.marginTop - marginAfter)
                        do relativeY <- relativeY + marginBefore
                        let y = relativeY
                        let layout, flow, layers = layoutBlockElem elem (availableWidth,None) mode mflow (flowRel.addTop(relativeY)) mlayers                        
                        do mflow <- flow
                        do mlayers <- layers
                        do marginAfter <- style.marginBottom
                        do relativeY <- relativeY + layout.size.height + marginAfter
                        (0, y), layout
                    | InlineFlow nodes -> 
                        let layout, flow, layers = layoutInlineSequence nodes (availableWidth,None) mode mflow (flowRel.addTop(relativeY)) mlayers
                        do mflow <- flow
                        do mlayers <- layers
                        let y = relativeY
                        do relativeY <- relativeY + layout.size.height
                        do marginAfter <- 0
                        (0, y), layout
            children <- children @ [(pos,layout)] 
        let children = children // un-mutable
        let width = List.max [for (_,layout) in children -> layout.size.width ]
        let height = relativeY
        BoxLayout(BoxSize(width, height), children), mflow, mlayers

(* The element box is a box including border and padding, but not margin *)
and layoutBlockElem (elem:IStyledElement) frame (mode:Mode) (flow:Flow) (flowRel:FloatOffset) (layers:Layers) : Layout*Flow*Layers =
    let style = elem.computedStyle()
    match style.display with
    | Display.None -> NoLayout, flow, layers
    | _ -> layoutBlockElem1 elem frame mode flow flowRel layers

and layoutBlockElem1 (elem:IStyledElement) (availableWidth:int,parentHeight:int option) (mode:Mode) (flow:Flow) (flowRel:FloatOffset) (layers:Layers) : Layout*Flow*Layers = 
    let style = elem.computedStyle()
    let leftOffset = style.borderLeftWidth + style.paddingLeft
    let rightOffset = style.borderRightWidth + style.paddingRight
    let topOffset = style.borderTopWidth + style.paddingTop
    let availableInnerWidth = availableWidth - (style.marginLeft + style.marginRight + leftOffset + rightOffset)
    let innerWidth =
        match style.width with
        | Size.Auto -> availableInnerWidth
        | Size.Pixels x -> min x availableInnerWidth
    let pos = (leftOffset, topOffset)
    let flowRel = flowRel.add leftOffset rightOffset topOffset
    let childLayout, flow, layers = layoutBlockContent elem innerWidth mode flow flowRel layers
    let chromeWidth = style.borderLeftWidth + style.borderRightWidth + style.paddingLeft + style.paddingRight
    let actualInnerWidth = 
        if mode=Auto 
        then innerWidth 
        else // Fit  
            match style.width with
            | Size.Auto -> childLayout.size.width
            | Size.Pixels x -> (max x childLayout.size.width) 
    let boxWidth = actualInnerWidth + chromeWidth
    let innerHeight =
        match style.height with
            | Size.Auto -> childLayout.size.height
            | Size.Pixels x -> max x childLayout.size.height        
    let boxHeight = innerHeight + style.borderTopWidth + style.borderBottomWidth + style.paddingTop + style.paddingBottom     
    ElementBoxLayout(BoxSize(boxWidth, boxHeight), elem, [(pos,childLayout)]) , flow, layers    

(*  Callback from float/line gnerator
    Margins around inline-boxes and floats are never collapsed, 
    so we create an extra extra box to contain the margins *)
and layoutInlineBlock  (elem:IStyledElement) (availableWidth:int,availableHeight:int option) (layers:Layers) : Layout * Layers =    
   let style = elem.computedStyle() 
   let pos = style.marginLeft, style.marginTop
   let childLayout, layers = layoutFlow elem (availableWidth,availableHeight) Fit layers
   let boxWidth = childLayout.size.width + style.marginLeft + style.marginRight
   let boxHeight = childLayout.size.height + style.marginTop + style.marginBottom
   ElementBoxLayout(BoxSize(boxWidth, boxHeight), elem, [(pos,childLayout)]) , layers

and layoutFlow (elem:IStyledElement) (availableWidth:int,parentHeight:int option) (mode:Mode) (layers:Layers) : Layout * Layers =
    (* layouts a flow, ie. a column of blocks wrapping around left or right floated blocks 
        Entry point for:
            - page
            - table cell
            - inline-block
    *)
    let flow = Flow([],[])
    let block, (Flow(leftFloats,rightFloats)), layers = layoutBlockElem elem (availableWidth,parentHeight) mode flow (FloatOffset(0,0,0)) layers
    (* right floats are placed relative to the right edge - here we calcualate to relative to the left edge *)
    let (ElementBoxLayout(boxSize, elem, children)) = block
    let width = boxSize.width
    let rightFloats1 = [for (x,y), layout in rightFloats -> ((width-x-layout.size.width,y),layout)]
    match block with
        | ElementBoxLayout(boxSize, elem, children) -> 
            ElementBoxLayout(boxSize, elem, (leftFloats @ rightFloats1 @ children)), layers 
        | NoLayout -> failwith "!"

let layoutRoot (elem:IStyledElement) (availableWidth:int) : Layout =
    (* creates a flow and an abs-positioning context *)
    let ElementBoxLayout(boxSize, elem, children), Layers(layers) = layoutFlow elem (availableWidth, None) Auto (Layers([]))
    ElementBoxLayout(boxSize, elem, children @ layers)

